home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d3
/
edit1234.arc
/
CARDS.BAS
next >
Wrap
BASIC Source File
|
1991-04-28
|
21KB
|
726 lines
'======== QB4 Source Code for CHRISTMAS CARDS =======
DECLARE SUB AlphaSort ()
DECLARE SUB Bottom (Text$)
DECLARE SUB Center (Down%, Text$)
DECLARE SUB DatInput ()
DECLARE SUB EditOvl ()
DECLARE SUB FileSelectScrn ()
DECLARE SUB Frame (Row%, LRow%, Col%, Box%)
DECLARE SUB GetEditor (Edit$)
DECLARE SUB HelpFile ()
DECLARE SUB InputScrn ()
DECLARE SUB Logon ()
DECLARE SUB MenuScrn ()
DECLARE SUB PrintScrn ()
DECLARE SUB QSearch (Search$, CaseSen%, RecFind%)
DECLARE SUB Spot (Down%, Over%)
DECLARE SUB Upper (Text$)
DECLARE SUB WrongFileScrn ()
COMMON SHARED x%, rn%, TotRec%, RecLen%, File$
Logon
ON KEY(10) GOSUB EndProgram
KEY(10) ON
TYPE CardRecord
Last AS STRING * 15
First AS STRING * 20
Addr AS STRING * 25
City AS STRING * 12
State AS STRING * 2
Zip AS STRING * 10
Remk AS STRING * 50
CarrRetn AS STRING * 2
END TYPE
DIM SHARED Easy AS CardRecord
DIM SHARED Alpha(200) AS CardRecord
ON ERROR GOTO ErrorProc
File$ = "cards.dat"
Page$ = "Cards-"
Header$ = "RECORD OF CARDS SENT AND RECEIVED"
SubHead$ = "Viola and George Jones"
Menu:
CLOSE
DO
MenuScrn
DO
a$ = UCASE$(INPUT$(1))
SELECT CASE a$
CASE IS = "C"
GOSUB CreateFile
CASE IS = "F"
GOSUB SelectFile
CASE IS = "H"
HelpFile
CASE IS = "L"
GOSUB SetScreen
CASE IS = "P"
GOSUB DataPrint
CASE IS = "X"
GOSUB EndProgram
CASE ELSE
END SELECT
LOOP WHILE INSTR("CFHLPX", a$) = 0
LOOP
CreateFile:
IF File$ = "cardssrt.dat" THEN GOSUB WrongFile
GOSUB OpenFile
rn% = TotRec% + 1
DO WHILE Easy.Last <> ""
DatInput
Center 1, " For each Field »» Type Data - then press <enter>."
Spot 2, 1: Center 1, "To Exit - Press <Enter> at next blank LAST NAME Space."
Spot 2, 1: Center 1, "╡ Do Not Exceed Highlighted Space ╞"
x% = 17: LOCATE x%, 6: LINE INPUT Easy.Last
IF Easy.Last = STRING$(15, " ") THEN
rn% = rn% - 2
GOSUB DispName
END IF
LOCATE x%, 36: LINE INPUT Easy.First: Spot 2, 6: LINE INPUT Easy.Addr
Spot 2, 6: LINE INPUT Easy.City: LOCATE x%, 31: LINE INPUT Easy.State
LOCATE x%, 46: LINE INPUT Easy.Zip: Spot 2, 6: LINE INPUT Easy.Remk
Easy.CarrRetn = CHR$(13) + CHR$(10)
PUT #1, rn%, Easy
rn% = rn% + 1
LOOP
SetScreen:
COLOR 1, 1, 8: CLS : Upper "V I E W T H E F I L E " + File$
Frame 8, 16, 8, 3
GOSUB OpenFile
Center 8, "╔═THE FILE CONTAINS" + STR$(TotRec%) + " RECORDS ═╗"
Center 2, "LIST STARTING AT RECORD NUMBER "
INPUT rn%
IF rn% > TotRec% THEN rn% = TotRec%
DispName:
COLOR 0, 3, 8: CLS : Bottom "VIEWING THE FILE"
GOSUB OpenFile
IF rn% <= 0 THEN rn% = 1
Cnt% = 1
FOR rn% = rn% TO TotRec%
PRINT TAB(58); : COLOR 15, 0: PRINT rn%: COLOR 0, 3
GET #1, rn%, Easy
PRINT TAB(24); RTRIM$(Easy.Last); ", "; Easy.First
PRINT TAB(24); Easy.Addr
PRINT TAB(24); RTRIM$(Easy.City); ", "; Easy.State; ", "; Easy.Zip
PRINT TAB(24); Easy.Remk
IF Cnt% >= 4 THEN
Cnt% = 1
rn% = rn% + 1
EXIT FOR
END IF
Cnt% = Cnt% + 1
NEXT
x% = 22: COLOR 0, 6
Center 1, "╠══LIST══EDIT══SEARCH═SORT══OR══MENU - L / E / * / M / S ══╣"
IF rn% >= TotRec% + 1 THEN
COLOR 14, 0: Center 2, "{{ LAST ITEM - PRESS » M « }}"
END IF
DO
COLOR 0, 3
a$ = UCASE$(INPUT$(1))
SELECT CASE a$
CASE IS = "L"
GOSUB DispName
CASE IS = "E"
GOSUB Editor
CASE IS = "*"
GOSUB DataSort
RETURN Menu
CASE IS = "M"
RETURN Menu
CASE IS = "S"
GOSUB TextSearch
CASE ELSE
END SELECT
LOOP WHILE INSTR("LE*MS", a$) = 0
Editor:
IF File$ = "cardssrt.dat" THEN GOSUB WrongFile
x% = 22: COLOR 31, 4
Center 1, SPACE$(20) + " ENTER NUMBER FOR LINE YOU WISH TO EDIT ══»"
COLOR 0, 15: INPUT rn%
IF rn% > TotRec% OR rn% < 1 THEN rn% = TotRec%
GET #1, rn%, Easy
DatInput
EditOvl
x% = 17: LOCATE x%, 6: Edit$ = Easy.Last: CALL GetEditor(Edit$)
IF Edit$ <> "" THEN
LINE INPUT Easy.Last
IF LEFT$(UCASE$(Easy.Last), 3) = "ZZZ" THEN
Easy.Last = "zzz{del}" + LEFT$(Edit$, 7)
PUT #1, rn%, Easy
RETURN DispName
END IF
END IF
LOCATE x%, 36: Edit$ = Easy.First: CALL GetEditor(Edit$)
IF Edit$ <> "" THEN LINE INPUT Easy.First
Spot 2, 6: Edit$ = Easy.Addr: CALL GetEditor(Edit$)
IF Edit$ <> "" THEN LINE INPUT Easy.Addr
Spot 2, 6: Edit$ = Easy.City: CALL GetEditor(Edit$)
IF Edit$ <> "" THEN LINE INPUT Easy.City
LOCATE x%, 31: Edit$ = Easy.State: CALL GetEditor(Edit$)
IF Edit$ <> "" THEN LINE INPUT Easy.State
LOCATE x%, 46: Edit$ = Easy.Zip: CALL GetEditor(Edit$)
IF Edit$ <> "" THEN LINE INPUT Easy.Zip
Spot 2, 6: Edit$ = Easy.Remk: CALL GetEditor(Edit$)
IF Edit$ <> "" THEN LINE INPUT Easy.Remk
Easy.CarrRetn = CHR$(13) + CHR$(10)
PUT #1, rn%, Easy
RETURN DispName
TextSearch:
IF File$ = "cardssrt.dat" THEN GOSUB WrongFile
COLOR 1, 3, 1: CLS : Bottom "«« YOU ARE IN SEARCH MODE »»"
CaseSen% = 1
DO WHILE RecFind% < 2
RecFind% = 0
LOCATE 24, 50: COLOR 0, 3: PRINT "] or Press <enter> to Quit";
LOCATE 24, 2: LINE INPUT "Enter Text to Find ══» ["; Search$
IF Search$ = "" THEN RETURN Menu
CALL QSearch(Search$, CaseSen%, RecFind%)
LOCATE 20, 1: COLOR 0, 3: PRINT SPACE$(400);
IF RecFind% = 0 THEN
LOCATE 22, 30: PRINT "....Did not find .."; CHR$(34); Search$; CHR$(34)
ELSE
LOCATE 21, 30: PRINT CHR$(34); Search$; CHR$(34); " Last Found in Record ";
COLOR 15, 1: PRINT rn%;
END IF
LOOP
DataPrint:
GOSUB OpenFile
PrintScrn
LOCATE 15, 32: INPUT rn%: LOCATE 15, 64: INPUT LastNum%
IF LastNum% > TotRec% THEN LastNum% = TotRec%
x% = 17: COLOR 15, 4
Center 1, "You Can Cancel Printing Now by Pressing <M>"
COLOR 0, 3: Center 2, "DO YOU WANT A HEADING - <Y>es <N>o <M>enu"
DO
a$ = UCASE$(INPUT$(1))
SELECT CASE a$
CASE IS = "Y"
GOSUB PrinterSetUp
LOCATE 11, 1: COLOR 0, 3
p = (48 - LEN(Header$)) / 2
LPRINT TAB(p); CHR$(14); Header$
p = (76 - LEN(SubHead$)) / 2
LPRINT TAB(p); SubHead$
LPRINT
LineFeed = 1
pg = 1: EXIT DO
CASE IS = "N"
x% = 17: COLOR 1, 7
Center 1, "INDICATE STARTING PAGE NUMBER FOR YOUR PRINT-OUT"
Center 2, SPACE$(18) + "STARTING PAGE NUMBER IS » "
INPUT pg
GOSUB PrinterSetUp
LPRINT
EXIT DO
CASE IS = "M"
RETURN Menu
CASE ELSE
END SELECT
LOOP WHILE INSTR("YNM", a$) = 0
DO WHILE rn% < LastNum% + 1
LineCnt% = 53
IF rn% <= 0 THEN rn% = 1
FOR rn% = rn% TO rn% + 8
IF INKEY$ = CHR$(27) THEN EXIT DO
LineCnt% = LineCnt% - 4
IF rn% > LastNum% THEN EXIT DO
GET #1, rn%, Easy
PRINT TAB(6); RTRIM$(Easy.Last); ", "; Easy.First
PRINT CHR$(13)
LPRINT TAB(12); RTRIM$(Easy.Last); ", "; Easy.First
LPRINT TAB(12); Easy.Addr
LPRINT TAB(12); RTRIM$(Easy.City); ", "; Easy.State; ", "; Easy.Zip
LPRINT TAB(12); Easy.Remk
LPRINT CHR$(13)
NEXT
GOSUB PageNumber: pg = pg + 1
LOOP
IF LineCnt% > 1 THEN
DO
LPRINT
LineCnt% = LineCnt% - 1
LOOP UNTIL LineCnt% < 1
END IF
CLOSE
GOSUB PageNumber
RETURN Menu
PageNumber:
LPRINT CHR$(13)
LPRINT CHR$(27); CHR$(71); : ' Bold
LPRINT CHR$(27); CHR$(83); CHR$(1); : ' Ss
LPRINT TAB(60); Page$; pg
PRINT TAB(25); pg; " Pages Sent to Printer"
LPRINT CHR$(27); CHR$(84); : ' Cancel Ss
LPRINT CHR$(27); CHR$(72); CHR$(1); : ' Cancel Bold
LPRINT CHR$(12)
RETURN
PrinterSetUp:
COLOR 0, 3: CLS : Frame 3, 8, 6, 1
COLOR 20, 3: Center 4, "Make Sure Printer is on Line"
Bottom "Press <Esc> to Abandon Printing"
LPRINT CHR$(27); CHR$(73); CHR$(2); : 'LQ
RETURN
DataSort:
CLS : Bottom "LOADING RECORDS INTO MEMORY"
CLOSE : OPEN "cards.dat" FOR RANDOM AS #1 LEN = LEN(Easy)
TotRec% = LOF(1) \ LEN(Easy)
FOR rn% = 1 TO TotRec%
GET #1, rn%, Alpha(rn%)
PRINT TAB(5); Alpha(rn%).Last; Alpha(rn%).First
NEXT
COLOR 0, 2: Frame 10, 14, 8, 3: Center 9, " « PLEASE WAIT FOR SORTING »"
CALL AlphaSort
AllRecords% = TotRec%
CLOSE : OPEN "cardssrt.dat" FOR RANDOM AS #1 LEN = LEN(Easy)
Bottom "WRITING RECORDS TO SORTED FILE"
LOCATE 16, 1
FOR rn% = 1 TO AllRecords%
PUT #1, rn%, Alpha(rn%)
PRINT TAB(30); Alpha(rn%).Last; Alpha(rn%).First
NEXT
CLOSE
GOSUB PageAdvn
RETURN
'=========U T I L I T I E S ======
PageAdvn:
LOCATE 25, 1: COLOR 7, 4: PRINT STRING$(80, 240);
LOCATE 25, 6: COLOR 0, 2: PRINT "▌ Press <Esc> for MENU ▐";
LOCATE 25, 45: COLOR 15, 1: PRINT "▌ Press <enter> to Continue ▐";
DO WHILE K$ <> CHR$(251)
K$ = INKEY$
IF K$ = CHR$(13) THEN RETURN
IF K$ = CHR$(27) THEN RETURN Menu
LOOP
OpenFile:
CLOSE : OPEN File$ FOR RANDOM AS #1 LEN = LEN(Easy)
TotRec% = LOF(1) \ LEN(Easy)
RecLen% = LEN(Easy)
RETURN
SelectFile:
FileSelectScrn
DO:
a$ = UCASE$(INPUT$(1))
SELECT CASE a$
CASE IS = "S"
File$ = "cardssrt.dat"
CASE IS = "U"
File$ = "cards.dat"
CASE ELSE
END SELECT
LOOP WHILE INSTR("SU", a$) = 0
RETURN Menu
WrongFile:
WrongFileScrn
GOSUB PageAdvn
RETURN Menu
ErrorProc:
COLOR 0, 3, 4: CLS : Frame 3, 16, 8, 3
x% = 4
SELECT CASE ERR
CASE 5, 13
Spot 2, 18: PRINT "* * * P R O G R A M M I N G E R R O R * * *"
Spot 2, 18: PRINT "Illegal Function Call or Type Mismatch"
CASE 25, 68, 71
Spot 2, 18: PRINT "* * * D E V I C E E R R O R * * *"
Spot 2, 18: PRINT "PRINTER or DISK DRIVE not ready or Not Available"
CASE 63, 64
Spot 2, 18: PRINT "* * *F I L E or R E C O R D E R R O R * * *"
Spot 2, 18: PRINT "Bad Record Number, OR Bad File Name"
CASE ELSE:
END SELECT
Spot 2, 18: PRINT "* * ERROR NUMBER * * ╔═══» ";
COLOR 15, 1: PRINT ERR: COLOR 0, 3
Spot 2, 18: LINE INPUT "Press <ENTER> To Return to MENU....."; anyk$
RESUME Menu
EndProgram:
COLOR 0, 3: SYSTEM
DEFINT A-Z
'
SUB AlphaSort STATIC
DIM s(100)
v = 3: s(1) = 1: s(2) = TotRec%
DO
DO
IF v = 1 THEN
EXIT SUB
ELSE
t = s(v - 2)
END IF
V9 = s(v - 2) + 1: J9 = s(v - 1)
IF V9 > J9 THEN
v = v - 2
EXIT DO
END IF
DO UNTIL V9 > J9
DO UNTIL Alpha(V9).Last + Alpha(V9).First > Alpha(t).Last + Alpha(t).First
V9 = V9 + 1
IF V9 > J9 THEN EXIT DO
LOOP
IF V9 > J9 THEN EXIT DO
DO UNTIL Alpha(J9).Last + Alpha(J9).First < Alpha(t).Last + Alpha(t).First
J9 = J9 - 1
IF V9 > J9 THEN EXIT DO
LOOP
IF V9 > J9 THEN EXIT DO
DO
SWAP Alpha(V9), Alpha(J9)
V9 = V9 + 1
J9 = J9 - 1
IF V9 > J9 THEN
GOTO FinalStep
ELSE
EXIT DO
END IF
LOOP
LOOP
FinalStep:
IF J9 < s(v - 2) THEN
J9 = s(v - 2)
END IF
IF V9 > s(v - 1) THEN
V9 = s(v - 1)
END IF
SWAP V9, J9
SWAP Alpha(t), Alpha(V9)
K9 = s(v - 2)
L9 = s(v - 1)
v = v - 2
IF V9 - K9 <= 0 THEN
IF L9 - J9 <= 0 THEN
EXIT DO
ELSE
s(v) = J9
s(v + 1) = L9
v = v + 2
EXIT DO
END IF
END IF
IF L9 - J9 <= 0 THEN
s(v) = K9
s(v + 1) = V9 - 1
v = v + 2
EXIT DO
END IF
IF V9 - K9 > L9 - J9 + 1 THEN
s(v) = K9
s(v + 1) = V9 - 1
s(v + 2) = J9
s(v + 3) = L9
v = v + 4
EXIT DO
END IF
s(v) = J9
s(v + 1) = L9
s(v + 2) = K9
s(v + 3) = V9 - 1
v = v + 4
EXIT DO
LOOP
LOOP
END SUB
DEFSNG A-Z
SUB Bottom (Text$)
LOCATE 25, 1: COLOR 14, 5: PRINT STRING$(80, 247);
Text$ = "█▄▄ " + Text$ + " ▄▄█"
p% = INT(82 - LEN(Text$)) / 2
LOCATE 25, p%: COLOR 15, 2: PRINT Text$;
LOCATE 1, 1: COLOR 0, 3
END SUB
SUB Center (Down%, Text$)
x% = x% + Down%
p% = INT((82 - LEN(Text$)) / 2)
LOCATE x%, p%: PRINT Text$;
END SUB
SUB DatInput
COLOR 1, 1, 8: CLS : Upper "D A T A I N P U T S C R E E N": Frame 3, 8, 4, 2
Spot 13, 62: COLOR 15, 0: PRINT "Record » "; rn%
LOCATE x%, 6: COLOR 15, 4: PRINT "LAST NAME"; SPACE$(6)
LOCATE x%, 36: PRINT "First Name, MI"; SPACE$(6)
Spot 2, 6: PRINT "Address"; SPACE$(18): Spot 2, 6: PRINT "City"; SPACE$(8)
LOCATE x%, 31: PRINT "State": LOCATE x%, 46: PRINT "Zip Code"; SPACE$(2)
Spot 2, 6: PRINT "R E M A R K S"; SPACE$(37)
x% = 17: LOCATE x%, 6: COLOR 1, 7: PRINT STRING$(15, 177)
LOCATE x%, 36: PRINT STRING$(20, 177)
Spot 2, 6: PRINT STRING$(25, 177): Spot 2, 6: PRINT STRING$(12, 177)
LOCATE x%, 31: PRINT STRING$(2, 177): LOCATE x%, 46: PRINT STRING$(10, 177)
Spot 2, 6: PRINT STRING$(50, 177)
x% = 3: COLOR 0, 7
END SUB
SUB EditOvl
Upper "T H E E D I T S C R E E N"
x% = 3: Center 1, "To Leave an Item Unchanged, Press <enter>"
Center 1, "┌┤ To Correct an Item - Press <Esc> to Enable the EDITOR; ├┐"
Center 1, "└┤then type New Data - Press <Enter> - Repeat for each Field├┘"
COLOR 1, 7
Center 2, "To delete this record, EDIT in " + CHR$(34) + "ZZZ" + CHR$(34) + " as Last Name and Press <enter>"
Spot 3, 26: COLOR 15, 1: PRINT RTRIM$(Easy.Last); ", "; Easy.First
Spot 1, 26: PRINT Easy.Addr
Spot 1, 26: PRINT RTRIM$(Easy.City); ", "; Easy.State; ", "; Easy.Zip
Spot 1, 26: PRINT Easy.Remk
Spot 3, 6: COLOR 1, 7: PRINT Easy.Last: LOCATE x%, 36: PRINT Easy.First
Spot 2, 6: PRINT Easy.Addr: Spot 2, 6: PRINT Easy.City;
LOCATE x%, 31: PRINT Easy.State; : LOCATE x%, 46: PRINT Easy.Zip
Spot 2, 6: PRINT Easy.Remk
END SUB
SUB FileSelectScrn
COLOR 0, 1, 8: CLS : Upper " FILE SELECTION MENU ": Frame 3, 10, 4, 3
Center 2, "Select <U>nsorted File for Searches, Editing, and Additions"
Center 1, "Select <S>orted file for final Print-out of your card list"
COLOR 0, 3: Center 3, " ▀ Choose <S> or <U> «» See Helpful Hints Below ▀ "
COLOR 0, 7: Frame 13, 22, 2, 2
Spot 12, 4
PRINT "Your <U>nsorted file is your source data; therefore all additions, edits"
Spot 1, 4
PRINT "etc , must be made using <U>nsorted file. The <S>orted file is recreated"
Spot 1, 4
PRINT "each time file is sorted; and any changes to <S>orted file would be"
Spot 1, 4
PRINT "over-written by Sort."
Spot 2, 4
PRINT "Remember to sort file and then select <S>orted file for final print-out"
Spot 1, 4
PRINT "of Card List."; ""
END SUB
SUB Frame (Row%, LRow%, Col%, Box%)
ss% = INT(80 - (2 * Col%))
SELECT CASE Box%
CASE 1
LOCATE Row%, Col%: PRINT CHR$(218); STRING$(ss%, 196); CHR$(191)
Side% = 179: GOSUB SideLines
LOCATE Row%, Col%: PRINT CHR$(192); STRING$(ss%, 196); CHR$(217);
CASE 2
LOCATE Row%, Col%: PRINT CHR$(201); STRING$(ss%, 205); CHR$(187)
Side% = 186: GOSUB SideLines
LOCATE Row%, Col%: PRINT CHR$(200); STRING$(ss%, 205); CHR$(188);
CASE 3
LOCATE Row%, Col%: PRINT CHR$(219); STRING$(ss%, 223); CHR$(219)
Side% = 219: GOSUB SideLines
LOCATE Row%, Col%: PRINT CHR$(219); STRING$(ss%, 220); CHR$(219);
CASE 6
Row% = Row% + 1: LRow% = LRow% + 2: Col% = Col% + 2
FOR Row% = Row% TO LRow%: LOCATE Row%, Col%
PRINT STRING$(ss% + 2, 219): NEXT
CASE ELSE
END SELECT
x% = 3
EXIT SUB
SideLines:
FOR Row% = Row% + 1 TO LRow%: LOCATE Row%, Col%:
PRINT CHR$(Side%); SPACE$(ss%); CHR$(Side%): NEXT
RETURN
END SUB
SUB GetEditor (Edit$)
x% = CSRLIN
p% = POS(0)
ss% = LEN(Edit$)
LOCATE x%, p%: COLOR 7, 0: PRINT Edit$
LOCATE x%, p%
DO
K$ = INKEY$
IF K$ = CHR$(13) THEN
COLOR 0, 7: PRINT Edit$
Edit$ = ""
EXIT SUB
END IF
LOOP WHILE K$ <> CHR$(27)
IF K$ = CHR$(27) THEN
COLOR 15, 4: PRINT SPACE$(ss%)
LOCATE x%, p%, 1
END IF
END SUB
SUB HelpFile
COLOR 0, 3, 0: CLS : Frame 3, 4, 12, 1
Center 1, "W O R K I N G"
HelpText = FREEFILE
OPEN "cards.hlp" FOR BINARY AS HelpText
Size = LOF(HelpText)
Help$ = STRING$(Size, 32)
GET HelpText, , Help$
CLOSE HelpText
DO
m% = 1
DO
CLS
FOR x% = 1 TO 25: LOCATE x%, 1: PRINT MID$(Help$, m%, 80);
m% = m% + 80
NEXT
DO
K$ = UCASE$(INKEY$)
IF K$ = CHR$(27) THEN EXIT SUB
IF K$ = CHR$(13) OR K$ = "T" THEN EXIT DO
LOOP
IF K$ = "T" THEN EXIT DO
IF m% >= Size THEN EXIT SUB
LOOP
LOOP
END SUB
SUB Logon
COLOR 1, 0, 1: CLS : Bottom "Copyright 1990 by George A. Jones"
COLOR 8: Frame 5, 20, 10, 6: COLOR 0, 2: Frame 5, 20, 10, 3
COLOR 0, 4: Frame 7, 17, 16, 3: COLOR 2, 7: Frame 9, 15, 21, 2
COLOR 0, 7: Center 7, "VIOLA AND GEORGE JONES"
COLOR 4, 2: Center 2, "█▒█▒█▒█▒█▒█"
COLOR 0, 7: Center 2, "RECORD OF CHRISTMAS CARDS"
SLEEP (5)
END SUB
SUB MenuScrn
COLOR 1, 2, 4: CLS : Bottom "Version 1.1": COLOR 2, 7: Frame 1, 2, 1, 2
x% = 1: COLOR 4, 7: Center 1, "CHRISTMAS CARD MAILING LIST"
COLOR 8: Frame 5, 18, 6, 6: COLOR 1, 3: Frame 5, 18, 6, 3
COLOR 11, 3: Frame 7, 8, 16, 1
COLOR 0, 3: Center 5, "P R O G R A M S E L E C T I O N "
p% = 12
Spot 4, p%: COLOR 0, 3: PRINT "<C>reate or Add to Card File "
LOCATE x%, 44: PRINT "<F>ile Selection Menu"
Spot 2, p%: PRINT "<L>ist, Search, Sort Records"
LOCATE x%, 44: PRINT "(P>rint The Card List"
Spot 2, p%: PRINT "<H>elp Screen Display"
LOCATE x%, 46: PRINT " e<X>it The Program"
x% = 10: p% = 13
Spot 2, p%: COLOR 14, 3: PRINT "C": LOCATE x%, 45: PRINT "F"
Spot 2, p%: PRINT "L": LOCATE x%, 45: PRINT "P"
Spot 2, p%: PRINT "H": LOCATE x%, 49, 0: PRINT "X"
COLOR 2, 7: Frame 22, 23, 1, 2
COLOR 4, 7: Center 20, " SELECT C - H - L - P - S - or - X "
END SUB
SUB PrintScrn
COLOR 0, 1, 8: CLS : Upper " Printer Instructions for " + File$
Frame 3, 21, 4, 1: Center 19, "┤ Select Names to Print ├"
x% = 4: Center 1, "SIZE OF PRINT FILE IS" + STR$(TotRec%) + " RECORDS"
Center 2, "╟─THERE WILL BE 9 RECORDS TO EACH PAGE─╢"
Spot 2, 10: COLOR 0, 2: PRINT "RECORDS 1 TO 90 WILL BE TEN PAGES"
Spot 2, 10: PRINT "LINES 91 TO 180 IS TWENTY PAGES"
Spot 2, 10: PRINT "LINES 181 TO 270 IS THIRTY PAGES"
COLOR 0, 7
Center 2, "Start Print at Record [ ] ▐ End Print at Record [ ]"
END SUB
SUB QSearch (Search$, CaseSen%, RecFind%)
CLOSE : OPEN "cards.dat" FOR BINARY AS 1
FileSize! = LOF(1)
Size! = FRE("") / 3
IF Size! > 32000 THEN Size! = 32000
Size! = INT(Size! / RecLen%) * RecLen%
Pass% = FileSize! / Size!
IF FileSize! / Size! > INT(Pass%) THEN Pass% = Pass% + 1
FOR r% = 1 TO Pass%
BgnRec% = 1
Text$ = SPACE$(Size!)
GET #1, , Text$
GOSUB SearchRecord
Text$ = ""
NEXT r%
CLOSE 1
EXIT SUB
SearchRecord:
DO
NextRecord = 0
IF CaseSen% = 1 THEN
MemAddr% = INSTR(BgnRec%, UCASE$(Text$), UCASE$(Search$))
ELSE
MemAddr% = INSTR(BgnRec%, Text$, Search$)
END IF
IF MemAddr% > 0 THEN
RecFind% = 1
Place% = (MemAddr% \ RecLen%) * RecLen% + 1
rn% = ((Size! / RecLen%) * r%) - ((Size! - Place%) \ RecLen%)
Cnt% = Cnt% + 1
Record$ = MID$(Text$, Place%, RecLen% - 2)
VIEW PRINT 10 TO 19: LOCATE 19, 80: PRINT : PRINT : PRINT : VIEW PRINT
LOCATE 20, 2: COLOR 0, 7: PRINT " Text Found in Record:";
COLOR 15, 0: PRINT rn%;
LOCATE 20, 50: COLOR 15, 1: PRINT Cnt%;
COLOR 0, 3: PRINT " Record(s) Found ";
LOCATE 21, 10: PRINT "╚═»...Press <enter> to continue Search.";
LOCATE 22, 23: PRINT "...OR ... or Press <Esc> for next SEARCH ";
Flash$ = MID$(Text$, MemAddr%, LEN(Search$))
FlashCol% = MemAddr% - Place% + 1
FlashRow% = 18
DO WHILE FlashCol% > 80
FlashCol% = FlashCol% - 80
FlashRow% = FlashRow% + 1
LOOP
LOCATE 17, 2: PRINT Record$;
COLOR 21, 7: LOCATE FlashRow%, FlashCol%: PRINT Flash$;
COLOR 0, 3
DO WHILE K$ <> CHR$(251)
K$ = INKEY$
IF K$ = CHR$(13) THEN
BgnRec% = Place% + RecLen% - 1
LOCATE 17, 2: PRINT Record$
NextRecord = 1
EXIT DO
END IF
IF K$ = CHR$(27) THEN
LOCATE 17, 2: PRINT Record$
CLOSE 1
EXIT SUB
END IF
LOOP
END IF
LOOP WHILE NextRecord = 1
RETURN
END SUB
SUB Spot (Down%, Over%)
x% = x% + Down%: LOCATE x%, Over%
END SUB
SUB Upper (Text$)
LOCATE 1, 1: COLOR 14, 4: PRINT STRING$(80, 196);
Text$ = "┤" + Text$ + "├"
p% = INT(82 - LEN(Text$)) / 2
LOCATE 1, p%: PRINT Text$
COLOR 0, 7
END SUB
SUB WrongFileScrn
COLOR 0, 0, 1: CLS : COLOR 0, 7: Frame 3, 20, 4, 2
COLOR 15, 1: Center 2, "You may be trying to use Wrong File"
COLOR 0, 7: Center 2, "Please use <U>nsorted File for Additions"
Center 1, "for Searches, and for Edits and Deletions."
Center 2, "Use <S>orted File for print-out of your final list. It may be"
Center 1, "necessary to use <L>ist, Search, Sort function to create"
Center 1, "<S>orted file, if file has not been sorted."
Center 2, "Please return to MENU and use <F>ile Selection Feature"
Center 1, "to Choose correct file."
COLOR 1, 7: Center 4, "[ Please See Helpful Hints at File Selection Menu ]"
END SUB